home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok19 / patterns / hipattern.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  169 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     HiPattern.mod
  3.     :Contents.      Definiert und setzt Füllmuster für 1:2-Graphik
  4.     :Contents      (Hires-normal)
  5.     :Author.      Bernd Preusing
  6.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  7.     :Phone.      04121/22486
  8.     :Copyright.      Public Domain
  9.     :Language.      Modula-2
  10.     :Translator.  M2Amiga V3.2e
  11.     :History.      V1.0  1-May-89 Preusing
  12.     :Bugs.      none
  13. ---------------------------------------------------------------------------*)
  14. IMPLEMENTATION MODULE HiPattern;
  15.  
  16. FROM SYSTEM    IMPORT    ADR, ADDRESS, INLINE;
  17. FROM Graphics    IMPORT    RastPortPtr;
  18.  
  19. (* from .def:
  20. TYPE
  21.   Pattern =
  22.     (full, wideLD, narrowLD, wideRD, narrowRD, wideR, narrowR, wideD, narrowD,
  23.      wideCross, narrowCross, half, quart, eight, wideCheck, narrowCheck,
  24.      bigDot, smallDot, wave, crossWave, bricks);
  25. *)
  26.  
  27. (* Pattern-Daten: *)
  28. PROCEDURE WideRO;(* $E- *)
  29. BEGIN INLINE(
  30.   00003H, 0000CH, 00030H, 000C0H, 00300H, 00C00H, 03000H, 0C000H)
  31. END WideRO;
  32.  
  33. PROCEDURE NarrowRO;(* $E- *)
  34. BEGIN INLINE(
  35.   03030H, 0C0C0H, 00303H, 00C0CH)
  36. END NarrowRO;
  37.  
  38. PROCEDURE WideLO;(* $E- *)
  39. BEGIN INLINE(
  40.   0C000H, 03000H, 00C00H, 00300H, 000C0H, 00030H, 0000CH, 00003H)
  41. END WideLO;
  42.  
  43. PROCEDURE NarrowLO;(* $E- *)
  44. BEGIN INLINE(
  45.   00C0CH, 00303H, 0C0C0H, 03030H)
  46. END NarrowLO;
  47.  
  48. PROCEDURE Waager1;(* $E- *)
  49. BEGIN INLINE(
  50.   0FFFFH, 00000H, 00000H, 00000H)
  51. END Waager1;
  52.  
  53. PROCEDURE Waager2;(* $E- *)
  54. BEGIN INLINE(
  55.   0FFFFH, 00000H)
  56. END Waager2;
  57.  
  58. PROCEDURE Senkr1;(* $E- *)
  59. BEGIN INLINE(
  60.   0C0C0H)
  61. END Senkr1;
  62.  
  63. PROCEDURE Senkr2;(* $E- *)
  64. BEGIN INLINE(
  65.   0CCCCH)
  66. END Senkr2;
  67.  
  68. PROCEDURE LargeCross;(* $E- *)
  69. BEGIN INLINE(
  70.   0C0C0H, 03300H, 00C00H, 03300H, 0C0C0H, 00033H, 0000CH, 00033H)
  71. END LargeCross;
  72.  
  73. PROCEDURE SmallCross;(* $E- *)
  74. BEGIN INLINE(
  75.   03030H, 0CCCCH, 00303H, 0CCCCH)
  76. END SmallCross;
  77.  
  78. PROCEDURE Half;(* $E- *)
  79. BEGIN INLINE(
  80.   0AAAAH, 05555H)
  81. END Half;
  82.  
  83. PROCEDURE Quart;(* $E- *)
  84. BEGIN INLINE(
  85.   0C0C0H, 00C0CH, 03030H, 00303H)
  86. END Quart;
  87.  
  88. PROCEDURE Eight;(* $E- *)
  89. BEGIN INLINE(
  90.   0C000H, 000C0H, 00C00H, 0000CH, 00300H, 00003H, 03000H, 00030H)
  91. END Eight;
  92.  
  93. PROCEDURE Check;(* $E- *)
  94. BEGIN INLINE(
  95.   0FF00H, 0FF00H, 0FF00H, 0FF00H, 000FFH, 000FFH, 000FFH, 000FFH)
  96. END Check;
  97.  
  98. PROCEDURE MidCheck;(* $E- *)
  99. BEGIN INLINE(
  100.   0F0F0H, 0F0F0H, 00F0FH, 00F0FH)
  101. END MidCheck;
  102.  
  103. PROCEDURE DDot;(* $E- *)
  104. BEGIN INLINE(
  105.   0007EH, 000FFH, 000FFH, 0007EH, 07E00H, 0FF00H, 0FF00H, 07E00H)
  106. END DDot;
  107.  
  108. PROCEDURE SmallDot;(* $E- *)
  109. BEGIN INLINE(
  110.   00000H, 01E00H, 03F00H, 01E00H, 00000H, 0001EH, 0003FH, 0001EH)
  111. END SmallDot;
  112.  
  113. PROCEDURE Wave;(* $E- *)
  114. BEGIN INLINE(
  115.   03C00H, 0C300H, 000C3H, 0003CH)
  116. END Wave;
  117.  
  118. PROCEDURE DWave;(* $E- *)
  119. BEGIN INLINE(
  120.   000C0H, 03CC0H, 0C300H, 00CC3H, 0303CH, 03000H, 00C00H, 00300H)
  121. END DWave;
  122.  
  123. PROCEDURE Bricks;(* $E- *)
  124. BEGIN INLINE(
  125.   0FFFCH, 0FFFCH, 0FFFCH, 00000H, 0F3FFH, 0F3FFH, 0F3FFH, 00000H)
  126. END Bricks;
  127.  
  128. PROCEDURE Heights;(* $E- *)
  129. BEGIN INLINE(
  130.   0,3,2,3,2,2,1,0,0,3,2,1,2,3,3,2,3,3,2,3,3)
  131. END Heights;
  132.  
  133. VAR Patterns: ARRAY Pattern OF ADDRESS;
  134.     HighPtr : POINTER TO ARRAY Pattern OF INTEGER;
  135.  
  136. PROCEDURE SetPattern(rp: RastPortPtr; nr:Pattern);
  137. BEGIN
  138.   WITH rp^ DO
  139.     areaPtrn:=Patterns[nr];
  140.     areaPtSz:=HighPtr^[nr];
  141.   END;
  142. END SetPattern;
  143.  
  144.  
  145. BEGIN
  146.   HighPtr:=ADR(Heights);
  147.   Patterns[full]    := NIL;
  148.   Patterns[wideLD]    :=ADR(WideRO);
  149.   Patterns[narrowLD]    :=ADR(NarrowRO);
  150.   Patterns[wideRD]    :=ADR(WideLO);
  151.   Patterns[narrowRD]    :=ADR(NarrowLO);
  152.   Patterns[wideR]    :=ADR(Waager1);
  153.   Patterns[narrowR]    :=ADR(Waager2);
  154.   Patterns[wideD]    :=ADR(Senkr1);
  155.   Patterns[narrowD]    :=ADR(Senkr2);
  156.   Patterns[wideCross]    :=ADR(LargeCross);
  157.   Patterns[narrowCross]    :=ADR(SmallCross);
  158.   Patterns[half]    :=ADR(Half);
  159.   Patterns[quart]    :=ADR(Quart);
  160.   Patterns[eight]    :=ADR(Eight);
  161.   Patterns[wideCheck]    :=ADR(Check);
  162.   Patterns[narrowCheck]    :=ADR(MidCheck);
  163.   Patterns[bigDot]    :=ADR(DDot);
  164.   Patterns[smallDot]    :=ADR(SmallDot);
  165.   Patterns[wave]    :=ADR(Wave);
  166.   Patterns[crossWave]    :=ADR(DWave);
  167.   Patterns[bricks]    :=ADR(Bricks);
  168. END HiPattern.mod
  169.